4  `p ! mL0BjDEHIJ `0BlDE0HI ɛ )`K @BÝDEHIJK `@l BlDE@HIl ) `E ` C B   `ЩM`` LLJLZ^)~uuLI/H毱ʕhiLLCLI'lH <Х ҥ | jf   Y  v :  Ѧ` :   `    ȱ  `` ĥ`EXECUTc$LBRANC<eHȱehLI0BRANC1[iLG(LOOPO| hhhhLc(+LOOPq膵HH}h}hL(DOHHHHLGb DIGI 800 08 0  HLBHLB(FIND7  Q)?-ȱQ #ieeHL@ȱȱȱеHL@ENCLOS,  8ȱŦLGŦLGEMIԑ KE ?TERMINA C $CMOV   ĦƧLGL U ( 666uuuLGU! `  *66866ƦLANY 5H5LBOҕ HLBXOҫ UHULBSP HL@SP LGRP LG;  hhLGLEAV $ LG> ? HHLGR8 Q hhLGJ b HL@0\ x ȔLG0q *LG uuLGD uuuuLMINUӰ 8LGDMINU 8L OVE HL@DRO SWA ' HLBDU ? HL@+7 N uuLTOGGLG o ULd ~ HLBCx LG LC L E[| N 9HHieLG m  CONSTAN 9HȱL@VARIABL  iHeL@USE#  eHeL@@  \  d  l  Bt  C/|  FIRSԅ  LIMIԏ  B/BUƛ  B/SCҧ  +ORIGIγ -  TI¿ M WIDT M WARNIN M FENC M D M VOC-LIN M BLM IM OUM SC&M OFFSE/M CONTEX8M CURRENDM "STATQM $BAS^M &DPiM (FLsM *CS|M ,RM .HLĎM 01 h  2 p  HERŬ |  ALLOԹ L    p  C  h     v  U   $8PIȔL % " RO; = % O %  SPACG  -DUY = Y=  TRAVERSi % j "Y%   LATES| [| |  LF j CF p  NF j- PF h j  !CS   ?ERRO % Y:  ?COM  f| v j ?EXE& f| j ?PAIR= j ?CSR | j ?LOADINf | v j COMPIL~ .O = = |  ۘ ` f  ݴ jf  SMUDG j m  HE jp  DECIMA j p  (;CODE O   ;COD  m, A =  +~ Y  D+ Y  ABӠ =  DABӲ =  MI ?Y%   MA "Y%   M = % & O  M = = ` ^ O ` % O %   &   /MOC = O ! O V%   MOb V  */MOp = O ! *~ %   M/MOĒ = ` ` ^ O % = ^ O  USš4 PREֿ4 +BU - = Y = |  UPDAT | | - | EMPTY-BUFFER ) DR rA  DR6 -A  BUFFEF | = = Y ` | Y` ` | - ` ` `  O  BLOCX A| = | = | ` = Y4v Y ` a= ` h p = | ` = v Y=  O   FLUSȡ  j f` -a z (LINE = O G   .LIN. 7 MESSAGQ | YpYj"A| fY: MSG # ` LOAc | = #| = ` # G #O # O   -- ` # | vL  8qȩq L CL L )L LG-DIS8  S䦵)L 㦵ĕL-BC. ` j ^ jG  R/m Y -R@:-W- = -f= - - -G-  6-    v `   FORGE = | j= | ` Y| =  := j| = ` Y p  | pv YO   BAC  BEGIX .h  ENDIi .p [ %  THE{  Dϗ x  LOOФ x [z_ +LOOе x [_ UNTI h [Y_ EN  AGAI h [:_ REPEA = = O O p  I Y` p  ELS5 p [:` % p p  WHILJ : SPACEk ` pY ` az <{ a  #   | a  SIGΫ M Yj-I  p| Mj "Yj j0 I #  v Y D. = % O  D ` a .< = O  K A \ | ` LISh  = 5 SCR # `j`  x Pa5| Yz  INDEt - %  x Pa` Y Y" z  TRIAĵ - x fx Gx %  {z -m  VLIS -, N| | ,| -?Y ` , = a| = v Y  L-O) --;  L-OFw - -;  LOCATŎ = -u?Y8p | = v Y -m:= ` "Y-m:{:- m CASE CS% p G | " S M R# M UPDAT. | | - |  DC9  .Z ( | p fh Y$ p ( | p | `-: STACK EMPTY  2DUh  LOAD-Eĺ - LOAD-AS -: LOAD-I - TEX  :sa   LIN! = - -5| 7  INVO/! --h --  INVOR! --h --  BELt! - -- - -  HXOԖ!  HPRԿ! - = - "Y -.a- a ADD!  DUM " h -f` = ` "a-` =  ` !az --` =  !z- z  U$" ` a BOOTSTARԑ"4 "MAKEBOOԨ" -" "| -fh "| ` -"L z MAKEY" TO FORMAT DISK 1D1:K'U ?' 1L v_ \b \LNO CARTRIDGEh' <0 $<}2 0P vL RUN FROM WHAT ADDRESS?TYPE "Y" TO CREATE MEM.SAV' ~0Y s0 ' 1 L FL1MEM.SAV FILE ALREAD=}Y EXISTSu( <0 2 0 0(( (( 1 ~0Yr( 1BʝD(EJ 1 B 1 .{(} 1 >}//3Hu ξL/L DRIVE TO WRITE DOS FILES TO?WRITING NEW DOS FILESTYPE "Y" TO WRITE DOS TO DRIVE 1.?}D1:DOS.SYSERROR - NOT VERSION 2 FORMAT. , &* բ( 1L `[) 0NΞ 0 L1M) 1@} FORTH DEFINITIONS HEX : L-ON 0780 ' CREATE ! ; : L-OFF ' FIRST CFA ' CREATE ! ; DECIMAL : LOCATE [COMPILE] ' DUP [ FENCE @ ] LITERAL > IF NFA 2 - @ DUP 0= IF 25 MESSAGE ELSE DUP 0 < IF 5 MESSAGE QUIT ELSE LIST ENDIF ENDIF ELSE 9 MESSAGE ENDIF ; DECIMAL --> HEX : CASE: SWAP 2 * + @ EXECUTE ; 6 USER S0 ( COMP STK ORG ) 8 USER R0 ( RET STK ORG ) : UPDATE PREV @ @ 8000 OR PREV @ ! ; : DCX DECIMAL ; DECIMAL --> ( STACK WORDS ) : .S ( PEEK AT STACK ) S0 @ SP@ - 2 / 1 - IF SP@ 2 - S0 @ 2 - DO I @ . -2 +LOOP ELSE ." STACK EMPTY " CR ENDIF ; : 2DUP OVER OVER ; : 2SWAP ROT >R ROT R> ; : RND 53770 DUP C@ SWAP C@ 128 + SWAP MOD ; : LOAD-ED 30 LOAD ; : LOAD-ASM 58 LOAD ; : LOAD-IO 6 LOAD ; DECIMAL --> ( TEXT LINE ) HEX : TEXT ( TEXT --> PAD ) HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ; : LINE ( ADR OF LINE-->STK ) DUP FFF0 AND 17 ?ERROR SCR @ (LINE) DROP ; : INVON FF 0668 C! FF 06BE C! ; : INVOF 7F 0668 C! 7F 06BE C! ; : BELL 06BE C@ FF 06BE C! FD EMIT 06BE C! ; INVOF DECIMAL --> ( HDUMPER ) HEX : HXOT <# # # #> TYPE ; : HPRT C@ 7F AND DUP 20 < IF DROP 2E THEN SPACE 1B EMIT EMIT SPACE ; : ADDR <# # # # # #> TYPE ; : DUMP ( ADDR CNT ) CR HEX 1 - 08 / 1+ 0 DO DUP 0 ADDR SPACE 8 0 DO DUP I + C@ 0 HXOT SPACE LOOP CR 4 SPACES 8 0 DO DUP I + HPRT LOOP 08 + CR LOOP DROP ; : U. 0 <# #S #> TYPE SPACE ; DECIMAL 80 LOAD FORTH DEFINITIONS ( CIO CALL CHEATER ) HEX ." I/O MODULE LOADING..." CR CREATE JSRCIO ( CALL TO ) ( CH #6 ) B5 C, 00 C, ( LDA TOS ) 86 C, B5 C, ( STX XSAVE ) A2 C, 60 C, ( LDX #$60 ) 20 C, C4 C, E4 C, ( JSR ) A6 C, B5 C, ( LDX XSAVE ) E8 C, E8 C, ( CLR STK ) 4C C, DF C, 0A C, ( 0A ) SMUDGE DECIMAL --> ( IOCB CONTSTANTS ) HEX 60 VARIABLE IO# : IO#@ IO# @ + ; : CHANID 340 IO#@ ; : CDEV# 341 IO#@ ; : CCMD 342 IO#@ ; : CSTAT 343 IO#@ ; : BUFADR 344 IO#@ ; : BUFLEN 348 IO#@ ; : CAUX1 34A IO#@ ; : CAUX2 34B IO#@ ; DECIMAL --> ( IOCB COMMANDS ) HEX 04 CONSTANT INOP 08 CONSTANT OUTOP : #-> ( ASSIGNS I0CB # ) 10 * DUP IO# ! ' JSRCIO 5 + C! ; 0 VARIABLE "K" -2 ALLOT 4B C, 3A C, 9B C, 0 VARIABLE "S" -2 ALLOT 53 C, 3A C, 9B C, DECIMAL --> ( IOCB CONT ) HEX 0 VARIABLE "P" -2 ALLOT 50 C, 3A C, 9B C, 0 VARIABLE "C" -2 ALLOT 43 C, 3A C, 9B C, 0 VARIABLE "E" -2 ALLOT 45 C, 3A C, 9B C, : CKSTAT CSTAT C@ DUP 80 AND IF 7F AND 21 + DUP ?ERROR ELSE DROP ENDIF ; DECIMAL --> ( OPEN IOCB ) HEX ( "K" INOP 0 I0CB# OPEN ) : OPEN #-> ( IOCB# ) 03 CCMD C! ( OPEN CMD) CAUX2 C! ( 0 USUAL ) CAUX1 C! ( IN/OUT ) BUFADR ! ( -> K: ) JSRCIO ( SET TO 6) CKSTAT ; ( ERROR? ) DECIMAL --> ( GET A CHAR TO STACK ) HEX ( GET ... ASCII TO STACK ) : GET #-> 0 ( DUMMY ) 07 CCMD C! ( GET CHAR ) 0 BUFADR ! ( 0 -> A ) JSRCIO CKSTAT ; : PUT #-> 0B CCMD C! ( PUT CHAR ) 0 BUFADR ! ( 0-> A ) JSRCIO CKSTAT DROP ; HEX : CLOSE #-> 0C CCMD C! JSRCIO CKSTAT ; DECIMAL --> ( PRINTER WORDS ) : PRON 4 CLOSE "P" OUTOP 0 4 OPEN ; : PROF 4 CLOSE "E" OUTOP 0 4 OPEN ; --> ( VOL,DIST,FREQ,VOICE, SND ) HEX : SOUND 0232 C@ 07 AND D20F C! 0 D208 C! DUP 3 > IF ." ILLEGAL CHAN" ABORT ENDIF 2 * D200 + >R >R 10 * OR EF AND 100 * R> OR R> ! ; : XSND D208 D200 DO 0 I C! LOOP ; DECIMAL --> ." GRAPHICS LOADING..." CR ( ALL USE CH # 6 ) : GRN 6 OPEN ; : GR. ( MODE 7 SPLIT ) 6 CLOSE >R "S" OUTOP 16 OR R> GRN ; : GR.16 6 CLOSE >R "S" OUTOP R> GRN ; HEX : SETCOLOR DUP 4 > IF ." ILLEGAL COLOR" . . . ELSE 02C4 + >R 10 * OR R> C! ENDIF ; DECIMAL --> ( PLOT DRAWTO ) HEX : CKER CSTAT C@ 8D = IF ." RANGE ERROR " QUIT ELSE CKSTAT ENDIF ; : DRAWTO ( Y,X,C ) 02FB C! 54 C! 55 ! 6 #-> 11 CCMD C! ( DRAW) 0 BUFADR ! JSRCIO CKER ; : PLOT >R OVER OVER OVER OVER DUP 0= IF 2+ ENDIF 1 - 5A C! 5B ! I DRAWTO R> DRAWTO ; DECIMAL --> ( POS. GR." ) HEX : POS. 54 C! 55 ! ; : GRTYPE -DUP IF OVER + SWAP DO I C@ 6 #-> 0B CCMD C! 0 BUFADR ! JSRCIO CKER DROP LOOP ELSE DROP ENDIF ; : GR(.") R COUNT DUP 1+ R> + >R GRTYPE ; : GR." 22 STATE @ IF COMPILE GR(.") WORD HERE C@ 1+ ALLOT ELSE WORD HERE COUNT GRTYPE ENDIF ; IMMEDIATE DECIMAL ;S (ERROR MESSAGES ) EMPTY STACK DICTIONARY FULL INCORRECT ADDRESS MODE NAME NOT UNIQUE LOCATE OUT OF RANGE DISK OUT OF RANGE FULL STACK DISK ERROR !! IN BOOT BEG FORTH VER 1.0 3/27/81 ( ERROR MESSAGES ) COMPILATION ONLY, USE IN DEF EXECUTION ONLY CONDITIONALS NOT PAIRED INCOMPLETE DEFINITION IN PROTECTED DICTIONARY USE ONLY WHEN LOADING OFF CURRENT EDIT SCREEN NOT COMPILED FROM DISK # OPERAND > $FF ILLEGAL USE OF Z-PAGE ILLEGAL ADDR MODE ( IOCB ERRORS ) BREAK ABORT IOCB OPEN NONEXISTENT DEVICE IOCB WRITE ONLY INVALID COMMAND DEVICE NOT OPEN BAD IOCB # IOCB READ ONLY ERROR EOF TRUNCATED RECORD DEVICE TIMEOUT DEVICE NOT ACKNOWLEDGE CMD SERIAL BUS FRAMING ERROR CURSOR OUT OF RANGE SERIAL BUS FRAME OVERRUN SERIAL CHECKSUM ERROR DEVICE ERROR BAD SCREEN MODE # FUNCTION NOT SUPPORTED SCREEN MODE EXCEEDED MEMORY ( SET COLD START ) FORTH DEFINITIONS HEX ' FORTH 4 + @ C +ORIGIN ! HERE 1E +ORIGIN ! VOC-LINK @ 20 +ORIGIN ! HERE 1C +ORIGIN ! ( FENCE) HERE 600 - 80 / 2+ 601 C! ( BOOT CNT ) DECIMAL ;S ( BOOTMAKER ) HEX 0 VARIABLE BOOTSTART : MAKEBOOT 600 BOOTSTART ! HERE BOOTSTART @ - 80 / 2+ 1 DO BOOTSTART @ I 0 R/W 80 BOOTSTART +! LOOP ; DECIMAL ;S ( MEMORY REF POINTER SET ) HEX : MEMSET 02E5 @ ( FETCH HI LIMIT ) DUP ' LIMIT ! 420 - DUP ' FIRST ! DUP USE ! PREV ! COLD ; ;S FORTH DEFINITIONS VOCABULARY EDITOR IMMEDIATE ( EDITOR CONT ) HEX : WHERE ( PRINT ERROR ) DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE CR HERE C@ - SPACES 5E EMIT [COMPILE] EDITOR QUIT ; EDITOR DEFINITIONS CR ." EDITOR LOADING..." --> ( EDITOR CONT ) HEX : -MOVE ( BLOCK ADR->LINE ) LINE C/L CMOVE UPDATE ; : E ( ERASE LINE ) LINE C/L BLANKS UPDATE ; : S DUP 1 - 0E DO I LINE I 1+ -MOVE -1 +LOOP E ; : /R PAD 1+ SWAP -MOVE ; -->  ( DUPLICATE ) 0 VARIABLE EBLK ( ENDING BLK ) 0 VARIABLE SBLK ( STARTIN BLK )0 VARIABLE PSBLK : DISP ( ->DEST ADR IN FRE RAM ) PSBLK @ B/BUF * HERE + ; : GTPAR ( SET UP DO AND PSBLK ) EBLK @ SBLK @ 0 PSBLK ! ; : MVIN ( MOVE BLKS INTO RAM ) GTPAR DO I BLOCK DISP B/BUF CMOVE 1 PSBLK +! LOOP ; DECIMAL --> : MOVOT ( WRITE RAM TO DISC ) GTPAR OFFSET @ + SWAP OFFSET @ + SWAP DO I BUFFER DISP SWAP B/BUF CMOVE 1 PSBLK +! UPDATE FLUSH LOOP ; : DUPLICATE ( STARTSCR ENDSCR ) 1+ B/SCR * EBLK ! B/SCR * SBLK ! EBLK @ SBLK @ - ' FIRST 1+ C@ DP 1+ C@ - 2 * 2 - > IF ." TOO MANY " QUIT ENDIF CR MVIN ." INSERT DESTINATION DISK " CR ." RETURN TO CONTINUE " KEY DROP CR MOVOT ; DECIMAL --> ( ATARI FORTH EDITOR ) HEX 0 VARIABLE COL ( USR COL PTR ) 0 VARIABLE LIN ( USR LIN PTR ) : EDLIST ( SPEC LIST FOR ED ) 7D EMIT DECIMAL CR DUP SCR ! ." SCR # " . 10 0 DO CR I 3 .R I SCR @ .LINE LOOP CR ; --> ( ATARI ED OS ACCESS WORDS ) HEX : ONCUR 0 02F0 C! ; : OFCUR 1 02F0 C! ; DECIMAL --> ( SMOVE ) DECIMAL : SMOVE ( SOURCE DEST # TOMV ) CR FLUSH EMPTY-BUFFERS ." CAUTION !!! " CR >R 2DUP SWAP ." MOVE " DUP . ." THRU " R + 1 - . ." -->" DUP . ." THRU " R + 1 - . SPACE ." Y OR N" CR R> KEY 89 = IF 0 DO OVER I + OVER I + COPY LOOP DROP DROP ELSE QUIT ENDIF ; DECIMAL --> ( LFCUR RTCUR ) HEX : (LFCUR) 1E EMIT ; : (RTCUR) 1F EMIT ; DECIMAL : RTCUR OFCUR COL @ 31 = IF 31 0 DO (LFCUR) LOOP 0 COL ! ELSE (RTCUR) 1 COL +! ENDIF ONCUR ; : LFCUR OFCUR COL @ IF (LFCUR) -1 COL +! ELSE 31 0 DO (RTCUR) LOOP 31 COL ! ENDIF ONCUR ; DECIMAL --> ( UPCUR DNCUR ) HEX : (DNCUR) 1D EMIT ; : (UPCUR) 1C EMIT ; : DNCUR OFCUR LIN @ F = IF F 0 DO (UPCUR) LOOP 0 LIN ! ELSE (DNCUR) 1 LIN +! ENDIF ONCUR ; : UPCUR OFCUR LIN @ IF (UPCUR) -1 LIN +! ELSE F 0 DO (DNCUR) LOOP F LIN ! ENDIF ONCUR ; DECIMAL --> ( HOME CURSOR ) HEX : LINCLEAR ( CURSOR->LIN 0 ) LIN @ DUP IF 0 DO UPCUR LOOP ELSE DROP ENDIF ; : COLCLEAR ( CURSOR->COL 0 ) COL @ DUP IF 0 DO LFCUR LOOP ELSE DROP ENDIF ; : HOMECUR ( CURSOR->HOME ) LINCLEAR COLCLEAR ; : CURSHOW (RTCUR) (LFCUR) ; --> ( ED CONT EDCR...TAB ) DECIMAL : BUFF-> ( BUFFER CHAR ADR ) LIN @ SCR @ (LINE) DROP COL @ + ; : EDCR ( SPECIAL CR FOR ED ) COL @ IF COLCLEAR ENDIF DNCUR ; 5 VARIABLE (TAB) : TAB 31 COL @ - (TAB) @ < IF COLCLEAR ELSE (TAB) @ COL @ OVER MOD - 0 DO RTCUR LOOP ENDIF ; DECIMAL --> ( ED CONT EDMIT ) HEX : ((EDEMIT)) EMIT (LFCUR) RTCUR COL @ 0= IF DNCUR ENDIF ; : TOBUFF ( SENDS CHAR TO LINE ) DUP ( CHAR ) BUFF-> C! ; : EDMIT DUP 20 < IF BELL DROP ELSE TOBUFF ((EDEMIT)) ENDIF UPDATE 0 ; DECIMAL --> ( LIN PRINT WORDS ) DECIMAL 0 VARIABLE TEMP1 0 VARIABLE TEMP2 : PTRSAV COL @ TEMP1 ! LIN @ TEMP2 ! ; : LINOUT COLCLEAR BUFF-> 32 TYPE 32 COL ! COLCLEAR ; : CURREST COLCLEAR TEMP1 @ -DUP IF 0 DO RTCUR LOOP ENDIF ; --> HEX : REFRESH ( OUTPUT ALL LINS) PTRSAV 10 LIN @ DO LINOUT DNCUR LOOP TEMP2 @ -DUP IF 0 DO DNCUR LOOP ENDIF ; DECIMAL --> ( CHAR INSERT WORDS ) : MOVRT DUP OVER 1 - C@ SWAP C! 1 - ; : XPAND ( SPREAD LIN AT CUR ) PTRSAV ( SAVE POINTERS ) 31 COL @ - DUP BUFF-> + SWAP 0 DO MOVRT LOOP BL SWAP C! LINOUT CURREST UPDATE ; DECIMAL --> ( CHAR INSERT WORDS ) : MOVLF DUP OVER 1+ C@ SWAP C! 1+ ; : CPAND ( SHRINK LIN AT CUR ) PTRSAV ( SAVE POINTERS ) BUFF-> 31 COL @ - 0 DO MOVLF LOOP BL SWAP C! ONCUR LINOUT CURREST UPDATE ; DECIMAL --> HEX : BKSP COL @ IF LFCUR ENDIF 20 EDMIT LFCUR DROP ; : FINI ( WRAP-UP ON ESC ) HOMECUR UPCUR (DNCUR) CR (UPCUR) ; : INSL ( SPREAD AT LIN # ) LIN @ S REFRESH ; : DELL ( DELETE LINE ) LIN @ D REFRESH ; DECIMAL --> ( EDITOR LOOK UP TABLE ) HEX EDITOR DEFINITIONS 10 VARIABLE XTABLE 1C C, ( UP ) 1D C, ( DN ) 1E C, ( LF ) 1F C, ( RT ) 7D C, ( HM ) 7E C, ( BS ) 0D C, ( CR ) 9D C, ( IL ) 9C C, ( DL ) FF C, ( XL ) FE C, ( CL ) 7F C, ( TB ) 9F C, ( ST ) 9E C, ( CT ) FD C, ( BL ) DECIMAL : KEYLIT 0 XTABLE @ 0 DO DROP DUP I XTABLE 2 + + C@ = IF LEAVE ENDIF I LOOP ; DECIMAL --> ( CONTROL WORDS ) CASE: CONTROL UPCUR DNCUR LFCUR RTCUR HOMECUR BKSP EDCR INSL DELL XPAND CPAND TAB BELL BELL BELL EDMIT ; : +KEY ( LIST BACK ONE ) SCR @ DUP 1 > IF 1 - ENDIF EDLIST ; : *KEY SCR @ 1+ EDLIST ; --> ( ED MODE CONTROL ) HEX : ED (UPCUR) (RTCUR) (RTCUR) (RTCUR) (RTCUR) INVON 1 COL ! F LIN ! HOMECUR CURSHOW BEGIN KEY DUP 1B XOR WHILE KEYLIT CONTROL DROP CURSHOW REPEAT FINI INVOF DROP ; DECIMAL --> ( ED MODE CONTROL ) DECIMAL : 0-> DROP 0 ; : L ( LIST SCREEN,WAIT ) INVON EDLIST BEGIN KEY DUP 27 XOR WHILE DUP 43 = IF +KEY 0-> ENDIF DUP 42 = IF *KEY 0-> ENDIF DUP 45 = IF ED 0-> ENDIF IF BELL ENDIF REPEAT DROP INVOF ; FORTH DEFINITIONS : KL [COMPILE] EDITOR EDITOR SCR @ L ; DECIMAL --> ( INVERSE ADDR, CNT ) HEX EDITOR DEFINITIONS : INTYPE INVON 0 DO I OVER + C@ 80 OR EMIT LOOP DROP INVOF ; : ( T IF BETWEEN L#'S ) DUP SBLK @ < 0= SWAP EBLK @ > 0= AND ; : IN.LINE (LINE) INTYPE ; DECIMAL --> ( ATARI FORTH EDITOR ) HEX : INVLIST 7D EMIT DECIMAL CR DUP SCR ! ." SCR # " . 10 0 DO CR I 3 .R I SCR @ OVER IF IN.LINE ELSE .LINE ENDIF LOOP CR ; 0 VARIABLE STBLK 0 VARIABLE SBBLK 0 VARIABLE SSCR 0 VARIABLE DTBLK 0 VARIABLE DBBLK 0 VARIABLE DSCR DECIMAL --> : FROM ( SCR LO HI L# ) 15 MIN DUP STBLK ! EBLK ! DUP SBBLK ! SBLK ! DUP SSCR ! INVLIST ; : /H LINE PAD 1+ C/L DUP PAD C! CMOVE ; : SS->DD STBLK @ 1+ SBBLK @ - 0 DO SSCR @ SCR ! I SBBLK @ + /H DSCR @ SCR ! I DBBLK @ + /R LOOP ; DECIMAL --> : INTO DUP SBLK ! DBBLK ! DSCR ! STBLK @ SBBLK @ - DBBLK @ + DUP EBLK ! DTBLK ! SS->DD DSCR @ INVLIST CR ." OK? Y/N " KEY 89 = IF KL ELSE EMPTY-BUFFERS ENDIF ; ;S ( ATARI ASSMBLER 9/19/80 ) FORTH DEFINITIONS VOCABULARY ASSEMBLER IMMEDIATE ' ASSEMBLER CFA ' ;CODE 8 + ! 10 VARIABLE ADRMD : CODE: ?EXEC !CSP 10 ADRMD ! CREATE [COMPILE] ASSEMBLER ; IMMEDIATE : C; CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE CR ." ASSEMBLER LOADING..." --> ( MSC LABELS TO FIG CODE ) ASSEMBLER DEFINITIONS HEX 47 +ORIGIN CONSTANT NEXT 3DF +ORIGIN CONSTANT PUSH0A B5 CONSTANT XSAVE 0 VARIABLE INCLS DECIMAL --> --> ( OPCODE TABLE ) HEX 0 VARIABLE OPTBL ( FF ILLEGAL )( A:) FF C, FF C, FF C, FF C, 08 C, FF C, FF C, FF C, ( 16) 0C C, 08 C, 08 C, 08 C, 0C C, 0C C, 0C C, 0C C, ( 8A) 04 C, 00 C, 00 C, 00 C, 04 C, 04 C, 04 C, 04 C, ( # ) 08 C, FF C, FF C, FF C, FF C, 00 C, 00 C, 00 C, ( 16,X) 1C C, 18 C, FF C, FF C, 1C C, FF C, FF C, 1C C, ( 16,Y) 18 C, FF C, FF C, FF C, FF C, FF C, 1C C, FF C, DECIMAL --> ( '8,X' ) HEX 00 C, FF C, FF C, FF C, FF C, FF C, FF C, FF C, ( '8',Y) 10 C, FF C, FF C, FF C, FF C, FF C, FF C, FF C, ( 8,X ) 14 C, 10 C, FF C, 10 C, 14 C, FF C, FF C, 14 C, ( 8,Y ) FF C, FF C, 10 C, FF C, FF C, FF C, 14 C, FF C, DECIMAL --> ( TABLE FETCH WORDS ) DECIMAL : ?TABLE ADRMD @ 8 * INCLS @ + OPTBL 2 + + C@ ; HEX : AMDCK ?TABLE DUP FF = 1C ?ERROR ; ( ADR MODE ERROR ) DECIMAL --> HEX : ?HI DUP FF00 AND ; DECIMAL : ADRMD! ADRMD ! ; : 16/8 ?HI IF ( LONG ADR ) 1 ELSE ( SHORT ADR ) 2 ENDIF ADRMD ! ; : #: ?HI 26 ?ERROR 3 ADRMD! ; : A: 0 ADRMD! ; DECIMAL --> : ,X ?HI ( TEST FOR 16/8 ) IF ( 16 ) 4 ELSE 8 ENDIF ADRMD! ; --> : ,Y ?HI IF ( 16 OR 8 ) 5 ELSE 9 ENDIF ADRMD! ; --> : ,X) ?HI 27 ?ERROR 6 ADRMD! ; : ),Y ?HI 27 ?ERROR 7 ADRMD! ; --> ( 1B IS Z-PAGE ERROR MSG ) ( CODE BUILDERS AAA CLASS ) : BLDCD INCLS ! ( CLASS ) 10 ADRMD @ = IF SWAP 16/8 SWAP ENDIF AMDCK OR C, ( TEST MODE ) ADRMD @ IF ( NOT A: ) ?HI IF , ELSE C, ENDIF ENDIF 10 ADRMD ! ; : T3A DUP C@ SWAP 1+ C@ BLDCD ; --> ( OPCODE FOLLIES ) HEX ( AAA CLASS INCLS 0 ) 61 0 T3A ADC, 21 0 T3A AND, C1 0 T3A CMP, A1 0 T3A LDA, 01 0 T3A ORA, E1 0 T3A SBC, 81 0 T3A STA, 41 0 T3A EOR, ( BB1 CLASS INCLS 1 ) C6 1 T3A DEC, E6 1 T3A INC, ( BBX CLASS INCLS 2 ) 86 2 T3A STX, DECIMAL --> ( BBY CLASS 3 INCLS ) HEX 84 3 T3A STY, ( BBB CLASS 4 INCLS ) 02 4 T3A ASL, 42 4 T3A LSR, 22 4 T3A ROL, 62 4 T3A ROR, ( CC CLASS 5 INCLS ) E0 5 T3A CPX, C0 5 T3A CPY, DECIMAL --> ( DDDX CLASS 6 INCLS ) HEX A2 6 T3A LDX, ( DDDY CLASS 7 INCLS ) A0 7 T3A LDY, DECIMAL --> : IMPL C@ C, ; HEX 00 IMPL BRK, 18 IMPL CLC, D8 IMPL CLD, 58 IMPL CLI, B8 IMPL CLV, CA IMPL DEX, 88 IMPL DEY, E8 IMPL INX, C8 IMPL INY, EA IMPL NOP, 48 IMPL PHA, 8A IMPL TXA, 98 IMPL TYA, 08 IMPL PHP, 68 IMPL PLA, 28 IMPL PLP, 40 IMPL RTI, 60 IMPL RTS, 38 IMPL SEC, F8 IMPL SED, 78 IMPL SEI, AA IMPL TAX, A8 IMPL TAY, BA IMPL TSX, 9A IMPL TXS, DECIMAL --> ( REL BRANCH ) DECIMAL HEX : RBR C@ C, 3 C, ; ( BRANCH AROUND JMP ) 90 RBR BCC, B0 RBR BCS, F0 RBR BEQ, 30 RBR BMI, D0 RBR BNE, 10 RBR BPL, 50 RBR BVC, 70 RBR BVS, DECIMAL --> ( JMP & BIT ) HEX : JMP, 4C C, , ; : (JMP), 6C C, , ; : JSR, 20 C, , ; : BIT, ?HI IF 2C C, , ELSE 24 C, C, ENDIF ; DECIMAL --> ( CONTROL STRUCTURES ) HEX : BEGIN, HERE ; : UNTIL, JMP, ; : WHILE, HERE 1 + 0 JMP, ; : REPEAT, HERE 3 + SWAP ! JMP, ; : IF, WHILE, ; : ELSE, WHILE, HERE ROT ! ; : ENDIF, HERE SWAP ! ; DECIMAL ;S ( PRIMES ) : TEST MOD 0= ; 4 VARIABLE COLS : PRINTS DUP 6 R COLS @ DUP 0= IF CR DROP 4 ELSE 1 - ENDIF COLS ! ; : PTEST DUP 2 / 3 DO DUP I TEST IF 0 LEAVE ENDIF 2 +LOOP DUP IF PRINTS ELSE DROP ENDIF DROP ; : PRIMES DO I PTEST 2 +LOOP ; 100 5 PRIMES ;S ( TEST ) : ^2 DUP DUP * . ; ( BEFEHLSERWEITERUNG 1) : <> = 0= ; : EPOS 88 @ ROT 40 * + + ; : EOUT EPOS ! ; : EINT EPOS C@ ; : ?TERM 753 C@ 0 <> ; : WKEY BEGIN ?TERM UNTIL ; : DDIR SWAP DO I LIST KEY 69 = IF LEAVE THEN LOOP ; : CLR 125 EMIT ; : POP R> R> DROP >R ; : EXIT R> DROP ; : VAR VARIABLE ; : SOUT UPDATE FLUSH ; --> ( BEFEHLSERWEITERUNG TEIL 2 ) 6 LOAD : ATRACT 128 77 ! ; : SK% 256 */ ; : HIRES 8 GR. 0 0 2 SETCOLOR 14 0 1 SETCOLOR ; : TXT 0 GR. 0 2 2 SETCOLOR 14 0 1 SETCOLOR ; : >= < 0= ; : <= > 0= ; : ?START 53279 C@ 1 AND 0= ; : ?SELECT 53279 C@ 2 AND 0= ; : ?OPTION 53279 C@ 4 AND 0= ; TXT LOAD-ED FORTH DEFINITIONS --> ( TRIGONOMETRISCHE FUNKTIONEN ) 0 VAR SINTAB : INITSIN HERE 40 ALLOT SINTAB ! 256 256 255 252 247 241 232 222 210 196 181 165 147 128 108 88 66 44 22 0 20 0 DO SINTAB @ I DUP + + ! LOOP ; : SINBEREICH 360 MOD DUP 0< IF 360 + THEN DUP 181 < IF 1 SWAP DUP 90 > IF 180 SWAP - THEN ELSE -1 SWAP DUP 270 > IF 360 SWAP - ELSE 180 - THEN THEN ; --> ( TRIGONOMETRISCHE FUNKTIONEN ) : SIN SINBEREICH 5 /MOD SINTAB @ SWAP DUP + + DUP 2 + @ SWAP @ DUP ROT SWAP - ROT 5 */ + * ; : COS 90 + SIN ; : TAN DUP SIN SWAP COS DUP 0= IF DROP DUP ABS / 32767 * ELSE 256 SWAP */ THEN ; : COT DUP COS SWAP SIN DUP 0= IF DROP DUP ABS / 32767 * ELSE 256 SWAP */ THEN ; INITSIN --> ( BEFEHLSERWEITERUNG TEIL 3 ) ( DEFINIERUNG VON STICK ) : STICK 4 MOD 632 + C@ ; : STRIG 4 MOD 644 + C@ 0= ; : HSTICK STICK DUP 8 AND 0= SWAP 4 AND 0= - ; : VSTICK STICK DUP 2 AND 0= SWAP 1 AND 0= - ; : D0= OR 0= ; : D- DMINUS D+ ; : D= D- D0= ; : D< D- 0< SWAP DROP ; : 4DUP >R >R 2DUP R ROT ROT R> R SWAP >R ROT ROT R> R> ; --> ( TRIGONOMETRISCHE FUNKTIONEN ) : ATN1 0 91 0 DO DROP DUP I DUP TAN ROT >= IF LEAVE THEN 5 +LOOP SWAP DUP ROT DUP ROT SWAP TAN <> IF 0 SWAP DUP 6 - SWAP DO DROP DUP I DUP TAN ROT <= IF LEAVE THEN -1 +LOOP SWAP DUP ROT DUP ROT SWAP TAN <> IF DUP ROT SWAP DUP 1 + TAN SWAP TAN ROT DUP ROT - ABS ROT ROT - ABS > IF DUP 1 + THEN THEN THEN ; : ATN DUP 0 <> IF DUP ABS DUP ROT / SWAP ATN1 SWAP DROP * THEN ; --> ( BEFEHLSERWEITERUNG TEIL 4 ) : DMAX 4DUP D< IF 2SWAP THEN DROP DROP ; : DMIN 4DUP D< 0= IF 2SWAP THEN DROP DROP ; : CCONST C@ ; : ARRAY 2DUP OVER 0< ROT ROT @ >= OR IF ." INDEX-ERROR " QUIT THEN SWAP 2 * + 2 + ; : CARRAY 2DUP OVER 0< ROT ROT @ >= OR IF ." INDEX-ERROR " QUIT THEN 2+ + ; ( DUMP ) HEX : HPRT C@ INVON DUP DUP 0D = SWAP 9B = OR IF DROP 2E THEN 1B EMIT EMIT INVOF ; : DUMP CR BASE @ ROT ROT HEX 1 - 8 / 1+ 0 DO DUP 0 ADDR SPACE 8 0 DO DUP I + C@ 0 HXOT SPACE LOOP SPACE 8 0 DO DUP I + HPRT LOOP 8 + LOOP DROP BASE ! ; DECIMAL ( 05.11.82 ) ( DIESEN SCREEN NICHT LOESCHEN DA SONST EINIGE BAUTEILE DES COMPUTERS UND DER FLOPPY ZERSTOERT WERDEN [SUCHE DER BEFEHLE ZWECKLOS] Ǡ͠Ϡ) ( 24.11.1982) : GRAPH-IT 100 LOAD ; : ED EDITOR ; ( GEOMETRISCHE FIGUREN ) 0 VAR KXM 0 VAR KYM 0 VAR KRD 0 VAR KFL 319 VAR XMAX 191 VAR YMAX : ?RANGE 2DUP 2DUP 0< SWAP 0< OR ROT ROT YMAX @ > SWAP XMAX @ > OR OR 0= ; : KREIS KRD ! 2DUP KYM ! KXM ! KRD @ + ?RANGE DUP KFL ! IF 1 PLOT THEN 361 5 DO I SIN KRD @ SK% KXM @ + I COS KRD @ SK% KYM @ + ?RANGE DUP KFL @ SWAP KFL ! SWAP IF IF 1 DRAWTO ELSE 1 PLOT THEN ELSE DROP DROP DROP THEN 5 +LOOP ; --> ( GEOMETRISCHE FIGUREN ) : KPOS DUP SIN 70 SK% 160 + SWAP COS 70 SK% 80 + ; : ROSETTE 360 SWAP / 361 0 DO DUP I KPOS ROT I + 361 SWAP DO 2DUP 1 PLOT I KPOS 1 DRAWTO ROT DUP >R ROT ROT R> +LOOP DROP DROP DUP +LOOP DROP ; : NROSETTE HIRES ROSETTE ; --> ( GEOMETRISCHE FIGUREN ) : BOX 2DUP 1 PLOT SWAP ROT 2DUP 1 DRAWTO >R ROT DUP R> 1 DRAWTO ROT SWAP OVER 1 DRAWTO 1 DRAWTO ; ( SIERPINSKI KURVE 1 ) 0 VAR H 0 VAR L 0 VAR X0 0 VAR Y0 : DUP ; : DUP ; : DUP ; : DUP ; : ?L -1 L +! L @ 0 >= ; : L+ 1 L +! ; : DRAW 2DUP 1 DRAWTO ; : H+ H @ + ; : H- H @ - ; : A ?L IF SWAP H+ SWAP H- DRAW SWAP H+ H+ SWAP DRAW SWAP H+ SWAP H+ DRAW THEN L+ ; ' A CFA ' ! --> ( SIERPINSKI KURVE 2 ) : B ?L IF SWAP H- SWAP H- DRAW H- H- DRAW SWAP H+ SWAP H- DRAW THEN L+ ; ' B CFA ' ! : C ?L IF SWAP H- SWAP H+ DRAW SWAP H- H- SWAP DRAW SWAP H- SWAP H- DRAW THEN L+ ; ' C CFA ' ! : D ?L IF SWAP H+ SWAP H+ DRAW H+ H+ DRAW SWAP H- SWAP H+ DRAW THEN L+ ; ' D CFA ' ! --> ( SIERPINSKI KURVE 3 ) : SIERPINSKI 0 L ! 48 DUP H ! DUP DUP + DUP 64 + X0 ! + Y0 ! 8 GR.16 0 0 2 SETCOLOR 14 0 1 SETCOLOR BEGIN L+ X0 @ H- X0 ! H @ 2 / H ! Y0 @ H+ Y0 ! X0 @ Y0 @ 2DUP 1 PLOT SWAP H+ SWAP H- DRAW SWAP H- SWAP H- DRAW SWAP H- SWAP H+ DRAW SWAP H+ SWAP H+ 1 DRAWTO DUP L @ <= UNTIL DROP WKEY ; ( GEOMETRISCHE FIGUREN ) 0 VAR RD1 0 VAR DW1 0 VAR VRD 0 VAR STUFE : KREISE2 DUP ; : KREISE1 STUFE @ SWAP STUFE ! SWAP RD1 @ SWAP RD1 ! 2SWAP STUFE @ 1 > IF 361 0 DO 2DUP I SIN RD1 @ SK% ROT + I COS RD1 @ SK% ROT + RD1 @ VRD @ / STUFE @ 1 - KREISE2 DW1 @ +LOOP DROP DROP ELSE RD1 @ KREIS THEN RD1 ! STUFE ! ; : KREISE 360 SWAP / DW1 ! VRD ! KREISE1 ; ' KREISE1 CFA ' KREISE2 ! ( TON TABELLE ) 15 VAR V : V @ 10 243 0 SOUND V @ 10 240 1 SOUND V @ 10 121 2 SOUND ; : V @ 10 217 0 SOUND V @ 10 214 1 SOUND V @ 10 108 2 SOUND ; : V @ 10 193 0 SOUND V @ 10 190 1 SOUND V @ 10 96 2 SOUND ; : V @ 10 182 0 SOUND V @ 10 179 1 SOUND V @ 10 91 2 SOUND ; --> ( TON TABELLE FORTS. ) : V @ 10 162 0 SOUND V @ 10 160 1 SOUND V @ 10 81 2 SOUND ; : V @ 10 144 0 SOUND V @ 10 142 1 SOUND V @ 10 72 2 SOUND ; : V @ 10 128 0 SOUND V @ 10 126 1 SOUND V @ 10 64 2 SOUND ; : V @ 10 121 0 SOUND V @ 10 119 1 SOUND V @ 10 60 2 SOUND ; : ?TASTE KEY 49 - DUP 0< IF -1 ELSE DUP 7 > IF -1 THEN THEN ; --> ( PIANO DEFINITIONS ) VOCABULARY PIANO IMMEDIATE PIANO DEFINITIONS : WAIT 100 0 DO LOOP ; : C -1 15 DO I V ! WAIT -1 +LOOP ; : D -1 15 DO I V ! WAIT -1 +LOOP ; : E -1 15 DO I V ! WAIT -1 +LOOP ; : F -1 15 DO I V ! WAIT -1 +LOOP ; : G -1 15 DO I V ! WAIT -1 +LOOP ; : A -1 15 DO I V ! WAIT -1 +LOOP ; --> ( PIANO FORTS. ) : H -1 15 DO I V ! WAIT -1 +LOOP ; : C1 -1 15 DO I V ! WAIT -1 +LOOP ; CASE: TON C D E F G A H C1 ; : PLAY BEGIN ?TASTE DUP -1 > WHILE TON REPEAT 15 V ! ; --> ( ORGAN DEFINITIONS ) VOCABULARY ORGAN IMMEDIATE ORGAN DEFINITIONS 15 V ! : C ; : D ; : E ; : F ; : G ; : A ; : H ; : C1 ; CASE: TON C D E F G A H C1 ; : PLAY BEGIN ?TASTE DUP -1 > WHILE TON REPEAT XSND ; 0 VAR X 0 VAR Y 0 VAR COLOR : TST 0 X ! 0 Y ! 1 COLOR ! 7 GR. BEGIN X @ Y @ COLOR @ PLOT 0 STRIG 0 HSTICK 0 VSTICK Y @ + DUP 0< IF 80 + THEN 80 MOD Y ! X @ + DUP 0< IF 160 + THEN 160 MOD X ! IF ." COLOR=" KEY 48 - DUP 0< IF 0 ELSE DUP 3 > IF 3 THEN THEN DUP . COLOR ! CR THEN ?START UNTIL ;